home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d18 / vis082s.arc / VISNET01.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-04-18  |  25.8 KB  |  828 lines
  1. { Ok Doug, I just throw it all together.. }
  2.  
  3.      boardrec=record     (* Bulletin Records.. so you don't get lost
  4.        boardname:mstr;      in this mess! *)
  5.        sponsor:string[34];
  6.        echo:Byte;
  7.        level,autodel:integer;
  8.        shortname:sstr;
  9.        conference:byte
  10.      end;
  11.  
  12.      Newsrec=Record
  13.         Location:Integer;
  14.         Level:Integer;
  15.         From:mstr;
  16.         When:longint;
  17.         Title:String[28];
  18.         MaxLevel:Integer;
  19.       End;
  20.  
  21.      BulRec=record                (* Message Header Record *)
  22.         leftby,leftto:String[30];
  23.         title,status:String[30];
  24.         when:longint;
  25.         where:lstr;
  26.         where2:lstr;
  27.         version:byte;
  28.         anon,recieved:boolean;
  29.         line,plevel:integer;
  30.         id:word;
  31.         cnet,fidonet,flag3,flag4,flag5,flag6,flag7,flag8:boolean;
  32.         realname:String[30];
  33.      end;
  34.  
  35.      NodeNetRec=Record                 (* Node List Record *)
  36.          Pass:Mstr;
  37.          Name:Mstr;
  38.          Phone:string[12];
  39.          Baud:Word;
  40.          LastDate:Longint;
  41.          Celerity,Fido,Cnet,Flag4,Flag5,Flag6:Boolean;
  42.          Node:string[10];
  43.          BaseSelection:Array[1..255] of boolean;
  44.      end;
  45.  
  46.  
  47.  
  48. (* This is from the WFC side when Net-Mail is forced *)
  49.  
  50. Procedure Do_Net_Mail;               (* ViSiON NetMail Version 1.01 *)
  51. Var NodeRec:NodeNetRec;
  52.     CurrentNodeNumber,NumMsgs:Integer;
  53.     Fnode:File of NodeNetRec;
  54.     chrr:Char;
  55.     simplex:boolean;
  56.     jo:integer;
  57.     finished:boolean;
  58.     oktosend:BooLean;
  59.  
  60.   Function FindBaseName(BaseId:Byte):SStr;
  61.   Var Board:BoardRec;
  62.       Fbd:File of BoardRec;
  63.       Sek:Integer;
  64.   Begin           (* Echo should equal baseId *)
  65.       Assign(Fbd,ConfigSet.BoardDi+'BoardDir');
  66.       Reset(Fbd);
  67.       Sek:=0;
  68.       FindBaseName:='';
  69.       Repeat
  70.         Seek(Fbd,Sek);
  71.         Read(Fbd,Board);
  72.         Inc(Sek);
  73.         If Board.Echo=BaseId then FindBaseName:=Board.ShortName;
  74.       Until (Board.Echo=BaseId) or Eof(Fbd);
  75.       Close(Fbd);
  76.   End;             (* End FindBaseName *)
  77.  
  78.   Procedure SendString(S:Lstr);
  79.   Var I:Integer;
  80.   Begin
  81.        For I:=1 to Length(S) Do SendChar(S[I]);
  82.   End;     (* End Send String *)
  83.  
  84.   procedure UpDateStory(Nums:Integer; Sent,Upgraded:Boolean);
  85.   Var T:Text;
  86.   Begin
  87.         appendfile(configset.forumdi+'Notices.BBS',t);
  88.         WriteLn(T,^M^S'────────────────────────────────────────────────────────────────────────');
  89.     WriteLn(T,^R'             On '+DateStr(Now)+' at '+TimeStr(Now)+' The Following Happened');
  90.     if not Sent then WriteLn(T,^R'('+Strr(Nums)+') Messages were sent to '+NodeRec.Name)
  91.     else WriteLn(T,^R'('+Strr(Nums)+') Messages were received from '+NodeRec.Name);
  92.     If Upgraded then WriteLn(T,^R'An Upgrade was received with this packet!');
  93.     WriteLn(T,^S'────────────────────────────────────────────────────────────────────────'^M);
  94.     TextClose(T);
  95.   End;      (* End UpdateStory *)
  96.  
  97.   Procedure GetItAll;
  98.   Var C:Char;
  99.   Begin
  100.    While NumChars>0 do
  101.    write(usr,getchar);
  102.   End;                    (* End GetItAll *)
  103.  
  104.  
  105.   Procedure SetUpForNetMail;
  106.   Begin
  107.     ClrScr;
  108.     WriteLn(Usr,'ViSiON Netmail version 1.01 (c) 1991 Ruthless Enterprises.');
  109.     If Not Exist(ConfigSet.ForumDi+'NodeList.BBS') then
  110.        Begin
  111.          WriteLn(Usr,'We WOULD send NetMail, BUT there seems to be no one to net with. MAKE');
  112.          WriteLn(Usr,'your NODELIST.BBS file BEFORE trying to attempt netmail!');
  113.          EnsureClosed;
  114.          Halt(0);
  115.        End;      (* End If then Begin *)
  116.     WriteLn(Usr,'First we must disable Auto-Answer!');
  117.     SendString('ATZ'+#13);
  118.     Delay(1500);
  119.     GetItAll;
  120.     SendString('ATS0=0'+#13);
  121.     Delay(500);
  122.     GetItAll;
  123.     WriteLn(Usr,'Now we will go ahead and set the Extended Registers to recognize everything.');
  124.     SendString('ATX6'+#13);
  125.     Delay(500);
  126.     GetItAll;
  127.     WriteLn(Usr,'Now we will open up the Node List file.');
  128.     Assign(Fnode,Configset.ForumDi+'NodeList.BBS');
  129.     Reset(Fnode);
  130.     CurrentNodeNumber:=0;
  131.     WriteLn(Usr,'There. All done.');
  132.   End;                  (* End SetUpForNetMail *)
  133.  
  134.   Procedure DialNodes;
  135.   Var Packaged:Boolean;
  136.  
  137.  
  138.        Function Connected:Boolean;
  139.        Var C:Char;
  140.            S:String;
  141.        Begin
  142.          Delay(9000);
  143.          S:='';
  144.                  While NumChars>0 Do
  145.                  Begin
  146.                      S:=S+getchar;
  147.            If C=#13 then S:='';
  148.            If Pos('[Hit Return]',S)>0 Then
  149.            Begin
  150.              WriteLn(Usr,'We MUST hit return!');
  151.              SendString(#13+#13+#13+#13);
  152.              S:='';
  153.            End;    (* End If then *)
  154.          End;      (* End Repeat Loop *)
  155.          If Carrier then Connected:=True;
  156.        End;         (* End Connected *)
  157.  
  158.    Procedure DialNode;
  159.  
  160.        Procedure PrepNetMail;
  161.        Var Ct,Loper:Integer;
  162.        NetPost:NetPostRec;
  163.        FNP:File of NetPostRec;
  164.        Bul:BulRec;
  165.        M:Message;
  166.        Bfile:File of BulRec;
  167.        BaseName:SStr;
  168.        CurBase:Byte;
  169.  
  170.        Procedure Package;
  171.        Begin
  172.        ClrScr;
  173.        WriteLn(Usr,'Making NetMail Package as per request.');
  174.        CurBase:=0;
  175.        NumMsgs:=0;
  176.        Assign(Fnp,Configset.NetDir+'NetMail.Pkg');
  177.        ReWrite(Fnp);
  178.        Loper:=0;
  179.        While Loper<255 Do
  180.         Begin
  181.            Inc(Loper);
  182.            If NodeRec.BaseSelection[Loper] Then Begin
  183.            BaseName:=FindBaseName(Loper);
  184.            If BaseName<>'' then Begin
  185.            Assign(Bfile,ConfigSet.BoardDi+BaseName+'.BUL');
  186.            Reset(Bfile);
  187.            Ct:=0;
  188.          While Not Eof(Bfile) Do
  189.            Begin
  190.              Seek(Bfile,Ct);
  191.              Read(Bfile,Bul);
  192.              If Bul.When>NodeRec.LastDate Then
  193.                Begin
  194.                Inc(NumMsgs);
  195.                NetPost.NetIdNum:=Loper;
  196.                NetPost.BulletinRec:=Bul;
  197.                ReloadText(Bul.Line,M);
  198.                NetPost.MessageRec:=M;
  199.                Seek(Fnp,FileSize(Fnp));
  200.                Write(Fnp,NetPost);
  201.                End; (* If Bul.When>NodeRec.LastDate *)
  202.              Inc(Ct);
  203.            End;  (* End While Not Eof *)
  204.          Close(Bfile);
  205.          End;         (* End if basename<>'' *)
  206.          End;         (* End if basethingie *)
  207.        End;           (* End Loper *)
  208.        Close(Fnp);
  209.       End;            (* End Package *)
  210.  
  211.       Procedure ZipPackage;
  212.       Var F:File;
  213.       Begin
  214.            Exec('PKZIP.EXE',Configset.NetDir+'Net.Zip '+ConfigSet.NetDir+'NetMail.Pkg');
  215.            Assign(F,ConfigSet.NetDir+'NetMail.Pkg');
  216.            Erase(F);
  217.            Close(F);
  218.       End;          (* End ZipPackage *)
  219.  
  220.  
  221.       Begin
  222.         Package;
  223.         If NumMsgs>0 Then Begin
  224.         ZipPackage;
  225.         Packaged:=True;
  226.         End;
  227.       End;                    (* End SendOutGoing *)
  228.  
  229.        Function Call(X:Lstr):Boolean;
  230.        Var Pre,Suf:Lstr;
  231.            Jo:Integer;
  232.            Finished:Boolean;
  233.  
  234.            Function Busy:Boolean;
  235.            Var K:String;
  236.                C:Char;
  237.            Begin
  238.                 K:='';
  239.                                 While NumChars>0 do k:=k+getchar;
  240.                 Busy:=False;
  241.                 If Pos('BUSY',K)>0 then Busy:=True;
  242.                 If Pos('NO CARRIER',K)>0 Then Busy:=True;
  243.                 If Pos('NO DIAL',K)>0 Then Busy:=True;
  244.            End;    (* End Busy *)
  245.  
  246.  
  247.        Begin
  248.             ClrScr;
  249.             WriteLn(Usr,'Dialing Number...');
  250.             If X='' then Exit;
  251.             dontanswer;
  252.             Delay(1500);
  253.             Pre:='';
  254.             Suf:='';
  255.             If Length(X)>7 then
  256.                Begin
  257.                     Pre:=ConfigSet.CoPre;
  258.                     Suf:=ConfigSet.CoSuf;
  259.                End;
  260.             If KeyPressed then Chrr:=ReadKey;
  261.             DoAnswer;
  262.             Delay(1200);
  263.             SendString('     ');
  264.             Delay(1600);
  265.             GetItAll;
  266.             SendString('ATDT'+Pre+X+Suf+#13);
  267.             Finished:=False;
  268.             delay(1500);
  269.             GetItAll;
  270.             Jo:=0;
  271.             Repeat
  272.                   Inc(Jo);
  273.                   Delay(10);
  274.                   If Busy then Finished:=True;
  275.                   If Finished then WriteLn(Usr,'Line was busy!'^M);
  276.                   If KeyPressed then Finished:=True;
  277.                   If KeyPressed then WriteLn(Usr,'User Abort!');
  278.                   If Carrier then Finished:=True;
  279.             Until Finished or (Jo>15000);
  280.             SendString(^M);
  281.             Call:=Carrier;
  282.        End;         (* End Call *)
  283.  
  284.  
  285.     Begin
  286.        PrepNetMail;
  287.        Window(1,1,80,25);
  288.        ClrScr;
  289.        TextColor(15);
  290.        WriteLn(Usr,'ViSiON NetMail Dialing '+NodeRec.Name+' @'+NodeRec.Phone);
  291.        TextColor(11);
  292.        WriteLn(Usr,'──────────────────────────────────────────────────────────────────────────');
  293.        TextColor(7);
  294.        Window(1,3,80,25);
  295.        Repeat
  296.         delay(2500);
  297.        Until Call(NodeRec.Phone) or
  298.          (Not WithinTime(ConfigSet.NetStc,Configset.NetEnc));
  299.     End; (* End DialNode *)
  300.  
  301.   Function SuccessfulNetMail:Boolean;
  302.   Var T:Text;
  303.       Received:Boolean;
  304.       F:File;
  305.       I:Integer;
  306.  
  307.   Procedure SendViaDSZ;
  308.   Begin
  309.   Delay(3000);
  310.   Exec('Dsz.Com',' port '+Strr(Configset.UseCo)+' ha slow speed '+strlong(baudrate)+' sz -m '+Configset.NetDir+'Net.Zip');
  311.     Assign(F,ConfigSet.NetDir+'Net.Zip');
  312.     Erase(F);
  313.     updatestory(NumMsgs,False,False);
  314.     NumMsgs:=0;
  315.   End;                   (* End SendViaDSZ *)
  316.  
  317.     Function ExecDsz:Boolean;
  318.     var ken:char;
  319.     Begin
  320.              If Exist(ConfigSet.WorkDir+'Net.Zip') then
  321.                  Begin
  322.                      Assign(F,ConfigSet.WorkDir+'Net.Zip');
  323.                      Erase(F);
  324.                  End;       (* End If Then *)
  325.              Delay(500);
  326.              GetItAll;
  327.              Repeat
  328.              Until (NumChars>0) or (Not Carrier);
  329.   Exec('Dsz.Com',' port '+Strr(ConfigSet.UseCo)+' ha slow speed '+strlong(baudrate)+' rz -m '+ConfigSet.WorkDir+'Net.Zip');
  330.        ExecDsz:=True;
  331.   End;
  332.  
  333.   Procedure ProcessIncomming;
  334.   Var Fnp:File of NetPostRec;
  335.       NetPost:NetPostRec;
  336.       M:Message;
  337.       B:BulRec;
  338.       Bfile:File of BulRec;
  339.       Upgrade,oktosend:Boolean;
  340.  
  341.       Procedure UnZipNet;
  342.       Var F:File;
  343.       Begin
  344.            SwapVectors;
  345.            Exec(GetEnv('Comspec'),'/C Pkunzip '+ConfigSet.WorkDir+'Net.Zip -o '+ConfigSet.WorkDir);
  346.            Assign(F,Configset.WorkDir+'Net.Zip');
  347.            Erase(F);
  348.            Close(F);
  349.       End;          (* End UnZipNet *)
  350.  
  351.       Procedure PostMsgs;
  352.       Var F:File;
  353.           TId:Word;
  354.           Current:Byte;
  355.           BaseName:Sstr;
  356.       Begin
  357.            ClrScr;
  358.            Upgrade:=False;
  359.            WriteLn(Usr,'Posting NetMail Messages.');
  360.            If Exist(ConfigSet.WorkDir+'Upgrade.Zip') then
  361.            Begin
  362.              Upgrade:=true;
  363.              Exec(GetEnv('ComSpec'),'/C Copy '+ConfigSet.WorkDir+'Upgrade.Zip '+
  364.              ConfigSet.NetType1Path+'Upgrade.Zip > NUL');
  365.              Assign(F,ConfigSet.WorkDir+'Upgrade.Zip');
  366.              Erase(F);
  367.              Close(F);
  368.            End;
  369.            If Exist(ConfigSet.WorkDir+'NetMail.Pkg') Then
  370.               Begin
  371.                  Assign(Fnp,Configset.WorkDir+'NetMail.Pkg');
  372.                  Reset(Fnp);
  373.                  NumMsgs:=0;
  374.                  Current:=0;
  375.                  While Not Eof(Fnp) Do
  376.                    Begin
  377.                      Read(Fnp,NetPost);
  378.                      If Current<>NetPost.NetIdNum Then Begin
  379.                         BaseName:=FindBaseName(NetPost.NetIdNum);
  380.                         Close(Bfile);
  381.                         If BaseName<>'' Then Begin
  382.                            Assign(Bfile,ConfigSet.BoardDi+BaseName+'.Bul');
  383.                            Reset(Bfile);
  384.                         End;   (* End if basename<>'' *)
  385.                      End;      (* End if current<>netpost.netidnum *)
  386.                    If NetPost.BulletinRec.Where=ConfigSet.Origin1 Then Else
  387.                       Begin
  388.                         Seek(Bfile,FileSize(BFile)-1);
  389.                         Read(Bfile,B);
  390.                         If B.Id=65535 then NetPost.BulletinRec.Id:=1 Else
  391.                             NetPost.BulletinRec.Id:=B.Id+1;
  392.                         B:=NetPost.BulletinRec;
  393.                         M:=NetPost.MessageRec;
  394.                         B.Line:=MakeText(M);
  395.                         B.When:=Now;
  396.                         Seek(Bfile,FileSize(Bfile));
  397.                         Write(Bfile,B);
  398.                         Inc(NumMsgs);
  399.                       End;           (* End if origin is here *)
  400.                    End;              (* End While Not Eof Do Begin *)
  401.                  Close(Fnp);
  402.                  Assign(F,ConfigSet.WorkDir+'NetMail.Pkg');
  403.                  Erase(F);
  404.                 NewPosts:=NewPosts+NumMsgs;
  405.                 Gnup:=Gnup+NumMsgs;
  406.                 WriteStatus;
  407.               End;        (* End If Exist Msgs *)
  408.       End;                (* End PostMsgs *)
  409.  
  410.  
  411.       Begin         (* Main ProcessIncomming *)
  412.            UnZipNet;
  413.            PostMsgs;
  414.            UpDateStory(NumMsgs,True,Upgrade);
  415.       End;           (* End ProcessIncomming *)
  416.  
  417.   Procedure UpDateNode;
  418.   Begin
  419.        NodeRec.LastDate:=Now;
  420.        Seek(Fnode,CurrentNodeNumber);
  421.        Write(Fnode,NodeRec);
  422.   End;                      (* End UpDateNode *)
  423.  
  424.   Begin
  425.        If Not Carrier And Not WithinTime(ConfigSet.NetStc,ConfigSet.NetEnc) then
  426.           Begin
  427.                SuccessfulNetMail:=True;
  428.                Exit;
  429.           End;
  430.        If Not Connected Then
  431.           Begin
  432.             SuccessfulNetMail:=False;
  433.             WriteLn(Usr,'NetMail failed.. Why???');
  434.             HangUp;
  435.             Delay(1600);
  436.             Exit;
  437.           End;   (* End Delay *)
  438.        SuccessfulNetMail:=False;
  439.        SendString(ConfigSet.NetPas+#13);
  440.        Delay(500);
  441.        GetItAll;
  442.        SendString(NodeRec.Node+#13);
  443.        Delay(500);
  444.        GetItAll;
  445.        SendString(NodeRec.Pass+#13);
  446.        Delay(500);
  447.        GetItAll;
  448.        Delay(1500);
  449.        If Not Carrier then Begin
  450.        Appendfile(ConfigSet.ForumDi+'Notices.BBS',t);
  451.        WriteLn(T,'On '+DateStr(Now)+' at '+TimeStr(Now)+' we had the wrong password');
  452.          WriteLn(T,'when we tried to send netmail to '+NodeRec.Name);
  453.          TextClose(T);
  454.          SuccessfulNetMail:=True;
  455.        End;                      (* End if not carrier *)
  456.        If ConfigSet.NetType1 then SendString('U'+#13);
  457.        oktosend:=False;
  458.        For I:=1 to 255 Do
  459.            Begin
  460.                 If NodeRec.BaseSelection[I] Then SendString(Strr(I)+#13);
  461.                 If NodeRec.BaseSelection[I] then GetItAll;
  462.                 oktosend:=False;
  463.            End;
  464.        SendString('0'+#13);
  465.        Delay(500);
  466.        GetItAll;
  467.        oktosend:=true;
  468.        If Packaged then
  469.           Begin
  470.                SendString('Y'+#13);
  471.                Delay(500);
  472.                GetItAll;
  473.                SendString('Y'+#13); (* This is the "Yes to receive" *)
  474.                If oktosend then SendViaDSZ;
  475.           End Else            (* End if packaged *)
  476.        Begin
  477.          SendString('N'+#13);
  478.          Delay(500);
  479.          GetItAll;
  480.          SendString('Y'+#13); (* yes to receive *)
  481.        end;
  482.        Delay(1500);
  483.        If Not Carrier then Begin
  484.           SuccessfulNetMail:=False;
  485.           Exit;
  486.        End;    (* If Not Carrier *)
  487.        Received:=ExecDsz;
  488.        HangUp;
  489.        If Received then ProcessIncomming;
  490.        UpDateNode;
  491.        SuccessfulNetMail:=True;
  492.   End;                         (* End SuccessfulNetMail *)
  493.  
  494.  
  495.   Begin
  496.        While Not Eof(Fnode) Do
  497.        Begin
  498.        Seek(Fnode,CurrentNodeNumber);
  499.        Read(Fnode,NodeRec);
  500.        Repeat
  501.              DialNode;
  502.        Until SuccessfulNetMail;   (* End Loop *)
  503.        Inc(CurrentNodeNumber);
  504.        End;      (* End While Not EofFnode *)
  505.   End;      (* End DialNodes *)
  506.  
  507.   Procedure ExitNetMail;
  508.   Begin
  509.     ClrScr;
  510.     WriteLn(Usr,'Now we''re done.. Setting back on Auto Answer.');
  511.     DoAnswer;
  512.     SendString('ATZ'+#13);
  513.     Delay(2500);
  514.     GetItAll;
  515.     SendString('ATS0=1'+#13);
  516.     Delay(700);
  517.     GetItAll;
  518.   End;
  519.  
  520. Begin
  521.      SetUpForNetMail;
  522.      DialNodes;
  523.      ExitNetMail;
  524.      EnsureClosed;
  525.      Halt(0);
  526. End;             (* End Do_Net_Mail *)
  527.  
  528. (* This is when it is recieved at the MATRIX  *)
  529.  
  530.  procedure get_incomming;
  531.   var i,j,k,l,NumBase,NodeNumber:integer;
  532.       done,sending,upgrade,email,bulletins:boolean;
  533.       f:file;
  534.       t:text;
  535.       ID,Pass:String;
  536.       Bases:Array[1..255] of Byte;
  537.       NodeRec:NodeNetRec;
  538.       NodeFile:File of NodeNetRec;
  539.  
  540.       Function ExecDsz:boolean;
  541.       var tries:integer;
  542.            ken:boolean;
  543.            f:file;
  544.       begin
  545.       ken:=false;
  546.       assign(f,configset.workdir+'Net.Zip');
  547.       if exist(configset.workdir+'Net.Zip') then erase(f);
  548.       close(f);
  549.       execdsz:=false;
  550.         tries:=0;
  551.          ClrScr;
  552.          WriteLn(Usr,'Receiving NetMail.');
  553.          exec('DSZ.COM',' port '+strr(configset.useco)+' speed '+strlong(baudrate)+' ha slow rz '+configset.workdir);
  554.          if dosexitcode=0 then ken:=true;
  555.       execdsz:=ken;
  556.   end;             (* End ExecDsz *)
  557.  
  558.   Function FindBaseName(BaseId:Byte):SStr;
  559.   Var Board:BoardRec;
  560.       Fbd:File of BoardRec;
  561.       Sek:Integer;
  562.   Begin           (* Echo should equal baseId *)
  563.       Assign(Fbd,ConfigSet.BoardDi+'BoardDir');
  564.       Reset(Fbd);
  565.       Sek:=0;
  566.       FindBaseName:='';
  567.       Repeat
  568.         Seek(Fbd,Sek);
  569.         Read(Fbd,Board);
  570.         Inc(Sek);
  571.         If Board.Echo=BaseId then FindBaseName:=Board.ShortName;
  572.       Until (Board.Echo=BaseId) or Eof(Fbd);
  573.       Close(Fbd);
  574.   End;             (* End FindBaseName *)
  575.  
  576.  
  577.   Procedure SendOutGoing; (* This sends the outgoing netmail. *)
  578.   Var Ct,Loper,NumMsgs:Integer;
  579.       NetPost:NetPostRec;
  580.       FNP:File of NetPostRec;
  581.       Bul:BulRec;
  582.       M:Message;
  583.       Bfile:File of BulRec;
  584.       BaseName:SStr;
  585.       CurBase:Byte;
  586.  
  587.       Procedure Package;
  588.       Begin
  589.       ClrScr;
  590.       WriteLn(Usr,'Making NetMail Package as per request.');
  591.       CurBase:=0;
  592.       NumMsgs:=0;
  593.       Assign(Fnp,Configset.NetDir+'NetMail.Pkg');
  594.       ReWrite(Fnp);
  595.       Loper:=0;
  596.       While Loper<NumBase Do
  597.        Begin
  598.          Inc(Loper);
  599.          BaseName:=FindBaseName(Bases[Loper]);
  600.          If BaseName<>'' then Begin
  601.          Assign(Bfile,ConfigSet.BoardDi+BaseName+'.BUL');
  602.          Reset(Bfile);
  603.          Ct:=0;
  604.          While Not Eof(Bfile) Do
  605.            Begin
  606.              Seek(Bfile,Ct);
  607.              Read(Bfile,Bul);
  608.              If Bul.When>NodeRec.LastDate Then
  609.                Begin
  610.                Inc(NumMsgs);
  611.                NetPost.NetIdNum:=Bases[Loper];
  612.                NetPost.BulletinRec:=Bul;
  613.                ReloadText(Bul.Line,M);
  614.                NetPost.MessageRec:=M;
  615.                Seek(Fnp,FileSize(Fnp));
  616.                Write(Fnp,NetPost);
  617.                End; (* If Bul.When>NodeRec.LastDate *)
  618.              Inc(Ct);
  619.            End;  (* End While Not Eof *)
  620.          Close(Bfile);
  621.          End;         (* End if basename<>'' *)
  622.        End;           (* End Loper *)
  623.        Close(Fnp);
  624.       End;            (* End Package *)
  625.  
  626.       Procedure ZipPackage;
  627.       Var F:File;
  628.       Begin
  629.            Exec('PKZIP.EXE',Configset.NetDir+'Net.Zip '+ConfigSet.NetDir+'NetMail.Pkg');
  630.            Assign(F,ConfigSet.NetDir+'NetMail.Pkg');
  631.            Erase(F);
  632.            Close(F);
  633.            If Upgrade then if Exist(ConfigSet.NetType1Path+'UPGRADE.ZIP') then
  634.             Exec('PKZIP.EXE',configset.netdir+'Net.Zip '+ConfigSet.NetType1Path+'UPGRADE.ZIP')
  635.             ELSE UPGRADE:=False;
  636.       End;          (* End ZipPackage *)
  637.  
  638.       Procedure SendDsz;
  639.       Var F:File;
  640.       Begin
  641.         ClrScr;
  642.         WriteLn(Usr,'Sending NetMail Packet.');
  643.  Exec('DSZ.COM',' port '+Strr(ConfigSet.UseCo)+' speed '+strlong(Baudrate)+' ha slow sz -m '+configset.NetDir+'Net.Zip');
  644.         Assign(F,ConfigSet.NetDir+'Net.Zip');
  645.         Erase(F);
  646.       End;       (* End SendDsz *)
  647.  
  648.       Procedure UpdateStory;
  649.             Begin
  650.            appendfile(configset.forumdi+'NOTICES.BBS',t);
  651.            WriteLn(T,^S'────────────────────────────────────────────────────────────────────────────');
  652.            WriteLn(T,^M^R'  On '+DateStr(Now)+' At '+TimeStr(Now)+' The Following Happened.');
  653.            WriteLn(T,^M^R'('+Strr(NumMsgs)+') Were sent to '+NodeRec.Name+'/'+NodeRec.Node);
  654.            If Upgrade then
  655.            WriteLn(T,^R'A ViSiON Upgrade was sent in this packet.');
  656.            WriteLn(T,^M);
  657.            WriteLn(T,^S'────────────────────────────────────────────────────────────────────────────');
  658.            WriteLn(T,^M);
  659.            TextClose(T);
  660.       End;              (* End UpdateStory *)
  661.  
  662.       Begin
  663.         Package;
  664.         ZipPackage;
  665.         SendDsz;
  666.         NodeRec.LastDate:=Now;
  667.         UpDateStory;
  668.       End;                    (* End SendOutGoing *)
  669.  
  670.   Procedure UpdateNode;
  671.   Begin
  672.     Assign(Nodefile,Configset.ForumDi+'NodeList.BBS');
  673.     Reset(NodeFile);
  674.     Seek(NodeFile,NodeNumber);
  675.     Write(NodeFile,NodeRec);
  676.     Close(Nodefile);
  677.   End;              (* End UpdateNode *)
  678.  
  679.   Procedure ProcessIncomming;
  680.   Var Fnp:File of NetPostRec;
  681.       NetPost:NetPostRec;
  682.       M:Message;
  683.       B:BulRec;
  684.       NumMsgs:Integer;
  685.       Bfile:File of BulRec;
  686.  
  687.       Procedure UpDateStory;
  688.       Begin
  689.            appendfile(ConfigSet.ForumDi+'Notices.BBS',t);
  690.            WriteLn(T,^S'───────────────────────────────────────────────────────────────────────────');
  691.            WriteLn(T,^M^R' On '+DateStr(Now)+' at '+TimeStr(Now)+' The Following Happened.');
  692.            WriteLn(T,^M'('+Strr(NumMsgs)+') Messages Were Received from '+NodeRec.Name+'/'+NodeRec.Node+^M);
  693.            WriteLn(T,^S'───────────────────────────────────────────────────────────────────────────');
  694.            TextClose(T);
  695.            NewPosts:=NewPosts+NumMsgs;
  696.            Gnup:=Gnup+NumMsgs;
  697.            WriteStatus;
  698.       End;              (* End UpDateStory *)
  699.  
  700.       Procedure UnZipNet;
  701.       Var F:File;
  702.       Begin
  703.            SwapVectors;
  704.            Exec(GetEnv('Comspec'),'/C Pkunzip '+ConfigSet.WorkDir+'Net.Zip -o '+ConfigSet.WorkDir);
  705.            Assign(F,Configset.WorkDir+'Net.Zip');
  706.            Erase(F);
  707.            Close(F);
  708.       End;          (* End UnZipNet *)
  709.  
  710.       Procedure PostMsgs;
  711.       Var F:File;
  712.           TId:Word;
  713.           Current:Byte;
  714.           BaseName:Sstr;
  715.       Begin
  716.            ClrScr;
  717.            WriteLn(Usr,'Posting NetMail Messages.');
  718.            If Exist(ConfigSet.WorkDir+'NetMail.Pkg') Then
  719.               Begin
  720.                  Assign(Fnp,Configset.WorkDir+'NetMail.Pkg');
  721.                  Reset(Fnp);
  722.                  NumMsgs:=0;
  723.                  Current:=0;
  724.                  While Not Eof(Fnp) Do
  725.                    Begin
  726.                      Read(Fnp,NetPost);
  727.                      If Current<>NetPost.NetIdNum Then Begin
  728.                         BaseName:=FindBaseName(NetPost.NetIdNum);
  729.                         Close(Bfile);
  730.                         If BaseName<>'' Then Begin
  731.                            Assign(Bfile,ConfigSet.BoardDi+BaseName+'.Bul');
  732.                            Reset(Bfile);
  733.                         End;   (* End if basename<>'' *)
  734.                      End;      (* End if current<>netpost.netidnum *)
  735.                    If NetPost.BulletinRec.Where=ConfigSet.Origin1 Then Else
  736.                       Begin
  737.                         Seek(Bfile,FileSize(BFile)-1);
  738.                         Read(Bfile,B);
  739.                         If B.Id=65535 then NetPost.BulletinRec.Id:=1 Else
  740.                             NetPost.BulletinRec.Id:=B.Id+1;
  741.                         B:=NetPost.BulletinRec;
  742.                         M:=NetPost.MessageRec;
  743.                         B.Line:=MakeText(M);
  744.                         B.When:=Now;
  745.                         Seek(Bfile,FileSize(Bfile));
  746.                         Write(Bfile,B);
  747.                         Inc(NumMsgs);
  748.                       End;           (* End if origin is here *)
  749.                    End;              (* End While Not Eof Do Begin *)
  750.                  Close(Fnp);
  751.                  Assign(F,ConfigSet.WorkDir+'NetMail.Pkg');
  752.                  Erase(F);
  753.               End;        (* End If Exist Msgs *)
  754.       End;                (* End PostMsgs *)
  755.  
  756.  
  757.       Begin         (* Main ProcessIncomming *)
  758.            UnZipNet;
  759.            PostMsgs;
  760.            UpDateStory;
  761.            NodeRec.LastDate:=Now;
  762.       End;           (* End ProcessIncomming *)
  763.  
  764.  Var Rec:Boolean;
  765.  
  766. Begin
  767.   WriteStr('ID:');
  768.   Id:=Input;
  769.   WriteStr('PASS:');
  770.   Pass:=Input;
  771.   FillChar(Bases,SizeOf(Bases),0);
  772.   NumBase:=0;
  773.   upgrade:=False;
  774.   Email:=False;
  775.   Bulletins:=False;     (* Note EMAIL and Bulletins are NOT added yet *)
  776.   Done:=False;
  777.   If Exist(ConfigSet.ForumDi+'NodeList.BBS') then Begin
  778.     Assign(NodeFile,ConfigSet.ForumDi+'NodeList.BBS');
  779.     Reset(NodeFile);
  780.     NodeNumber:=-1;
  781.     Done:=False;
  782.     While Not Eof(NodeFile) and not done Do
  783.       Begin
  784.         Read(NodeFile,NodeRec);
  785.         Inc(NodeNumber);
  786.         If (Match(Id,NodeRec.Node)) and (Match(Pass,NodeRec.Pass)) then Done:=True;
  787.       End;
  788.       Close(NodeFile);
  789.     End;              (* End if exist loop *)
  790.   If not Done then Begin
  791.      WriteLn('Something must be wrong!');
  792.      Delay(1500);
  793.      HangUp;
  794.      EnsureClosed;
  795.      Halt(0);
  796.   End;
  797.   I:=1;
  798.   Repeat
  799.     WriteStr('BASE:');
  800.     If Input='U' then Begin
  801.       I:=-1;
  802.       Upgrade:=True;
  803.       End
  804.       ELSE Begin
  805.     I:=Valu(Input);
  806.     If I>0 then Begin
  807.       Inc(NumBase);
  808.       Bases[NumBase]:=I;
  809.     End; (* End if then *)
  810.     End; (* End if else begin *)
  811.   Until (I=0) or HungUpOn;
  812.   WriteStr('SEND:');
  813.   Sending:=Yes;
  814.   WriteStr('RECEIVE:');
  815.   Rec:=Yes;
  816.   If Sending then Sending:=ExecDsz;
  817.   If rec Then SendOutGoing;
  818.   Delay(1500);
  819.   HangUp;
  820.   DontAnswer;
  821.   If Sending Then ProcessIncomming;
  822.   UpDateNode;
  823.   EnsureClosed;
  824.   Halt(0);
  825. End;                   (* End Get_Incomming *)
  826.  
  827.  
  828.